home *** CD-ROM | disk | FTP | other *** search
/ C/C++ Users Group Library 1996 July / C-C++ Users Group Library July 1996.iso / vol_100 / 122_01 / pbase2 < prev    next >
Text File  |  1984-03-05  |  23KB  |  1,099 lines
  1. % *********************************************************
  2. % *                              *
  3. % * PISTOL-Portably Implemented Stack Oriented Language      *
  4. % *            Version 2.0              *
  5. % * (C) 1983 by    Ernest E. Bergmann              *
  6. % *        Physics, Building #16              *
  7. % *        Lehigh Univerisity              *
  8. % *        Bethlehem, Pa. 18015              *
  9. % *                              *
  10. % * Permission is hereby granted for all reproduction and *
  11. % * distribution of this material provided this notice is *
  12. % * included.                          *
  13. % *                              *
  14. % *********************************************************
  15. % BASIC DEFINITIONS FOR PISTOL 2.0
  16. %
  17. % DECIMAL mode initially
  18. %
  19. +5 W * USER + W@ W@ % used for 'LAST-PRIMITIVE
  20. 'W*  W 1 - IF : W * ;
  21.     ELSE $: ;$
  22.     THEN
  23. 'USER+ USER IF $: USER + ;$
  24.         ELSE $: ;$
  25.         THEN
  26. 'TRANS $: W* USER+ ;$ % TRANSLATES LOGICAL ADDRESSES TO ACTUAL RAM ADDR.
  27.         % TRANS MUST USE "$:" FOR THE 'DIS PACKAGE
  28. 'TRANS@ : TRANS W@ ;
  29. 'ARGPATCH : +5 TRANS@  W@ W + W! ; % for 'CONSTANT 'VARIABLE, 'ARRAY
  30. 'CONSTANT : : 0 ; ARGPATCH ;
  31.  
  32. 'LAST-PRIMITIVE         CONSTANT
  33.  
  34. -1    'TRUE            CONSTANT
  35. 0    'FALSE            CONSTANT
  36.  
  37. -21    TRANS@    'MININT        CONSTANT
  38. -20    TRANS@    'MAXLINNO    CONSTANT
  39. -19    TRANS@    'CHKLMT        CONSTANT
  40. -18    TRANS@    'RAMMIN        CONSTANT
  41. -17    TRANS@    'STRINGSMIN    CONSTANT
  42. -16    TRANS@    'STRINGSMAX    CONSTANT
  43. -15    TRANS@    'VBASE        CONSTANT
  44. -14    TRANS@    'VSIZE        CONSTANT
  45. VBASE VSIZE W* + 'VMAX        CONSTANT
  46. -13    TRANS@    'CSIZE        CONSTANT
  47. -12    TRANS@    'LSIZE        CONSTANT
  48. -11    TRANS@    'RSIZE        CONSTANT
  49. -10    TRANS@    'SSIZE        CONSTANT
  50. -9    TRANS@    'LINEBUF    CONSTANT
  51. LINEBUF 200 + 'EDITBUF        CONSTANT
  52. -8    TRANS@    'COMPBUF    CONSTANT
  53. -7    TRANS@    'RAMMAX        CONSTANT
  54. -6    TRANS@    'MAXORD        CONSTANT
  55. -5    TRANS@    'MAXINT        CONSTANT
  56. -4    TRANS@    'VERSION    CONSTANT
  57. -3    TRANS@ 'NEWLINE        CONSTANT
  58. -2    TRANS@    'READ_PROTECT    CONSTANT
  59. -1    TRANS@    'WRITE_PROTECT    CONSTANT
  60.  
  61. 'ON : TRUE SWAP W! ;
  62. 'OFF : FALSE SWAP W! ;
  63. 'INFILE : +7 TRANS@ ;
  64.  
  65. 'BYE : +31 TRANS ON ;
  66. +34    TRANS    'ABORT-PATCH    CONSTANT
  67. +33    TRANS    'CONVERT-PATCH    CONSTANT
  68. +32    TRANS    'PROMPT-PATCH    CONSTANT
  69. +29    TRANS '(PISTOL<)    CONSTANT
  70. +28    TRANS '.V        CONSTANT
  71. +24    TRANS '#GET-ADDR CONSTANT % FOR PATCHING #GETLINE
  72. +23    TRANS 'TAB-SIZE        CONSTANT
  73. +22    TRANS 'TRACE-ADDR     CONSTANT
  74. +21    TRANS 'ENDCASE-PATCH    CONSTANT
  75. +20    TRANS 'COLUMN        CONSTANT
  76. +19    TRANS 'TERMINAL-WIDTH    CONSTANT
  77. +18    TRANS '#LINES        CONSTANT
  78. +17    TRANS 'TERMINAL-PAGE    CONSTANT
  79. +16    TRANS 'COMPILE-END-PATCH CONSTANT
  80. +15    TRANS 'TRACE-LEVEL    CONSTANT % USED AS BOOLEAN
  81.                     % AND LEVEL INDICATOR
  82. +13    TRANS 'RAISE        CONSTANT
  83. +11    TRANS 'NEXTCH^        CONSTANT
  84. +10    TRANS 'CONSOLE        CONSTANT
  85. +9    TRANS 'ECHO        CONSTANT
  86. +8    TRANS 'LIST        CONSTANT
  87. +6    TRANS 'PREVIOUS        CONSTANT % UPDATED BY (V)FIND
  88. +5    TRANS 'CURRENT        CONSTANT
  89. +4    TRANS 'OLD-EOSTRINGS    CONSTANT % END OF PERMANENT
  90.                     % STRINGS VARIABLE
  91. +3    TRANS 'CURRENT-EOSTRINGS CONSTANT
  92. +2    TRANS '.D        CONSTANT
  93. +1    TRANS '.C        CONSTANT
  94. +0    TRANS 'RADIX        CONSTANT
  95. STRINGSMIN 'RADIX-INDICATOR    CONSTANT
  96. STRINGSMIN 1 + 'SYNTAXBASE    CONSTANT
  97.  
  98. 'NOP : ;
  99. 'DUP : 0 S@ ;
  100. '1+ : 1 + ;
  101. '1- : 1 - ;
  102. 'W+ : W + ;
  103. 'W- : W - ;
  104. 'W<- : SWAP W! ;
  105. '1+W! : DUP W@ 1+ W<- ;
  106. 'W+W! : DUP W@ W+ W<- ;
  107. 'CR : NEWLINE TYO ;
  108. 'SPACE : 32 TYO ;
  109. 'SPACES : 0 DO SPACE LOOP ;
  110. 'DDUP : 1 S@ 1 S@ ;
  111. 'OVER : 1 S@ ;
  112. '2OVER : 2 S@ ;
  113. '3OVER : 3 S@ ; % USED BY DIS PACKAGE(DON'T CHANGE!)
  114. 'UNDER : SWAP DROP ;
  115. 'TYPE : 0 DO DUP C@ TYO 1+ LOOP DROP ;
  116. 'LT : MININT SWAP 1- .. ;
  117. 'GT : 1+ MAXINT .. ;
  118. 'LINE-SPACE? : COLUMN W@ + TERMINAL-WIDTH W@ LT
  119.     IF ELSE CR THEN ;
  120.  
  121. 'MSG : DUP C@ LINE-SPACE?
  122.      DUP 1+ SWAP C@ TYPE ;
  123.  
  124. 'IFCR : COLUMN W@ 0 GT IF CR THEN ;
  125. 'ERR : IFCR ABORT ;
  126.  
  127. 'MERR : CONSOLE ON MSG ERR ;
  128.  
  129.  
  130. 'INDENT : DUP TERMINAL-WIDTH W@ LT IF
  131.     COLUMN W@ - SPACES
  132.     ELSE IFCR DROP
  133.     THEN ;
  134.  
  135. 'TAB : 9 TYO ;
  136.  
  137. 'TABS : 0 DO TAB LOOP ;
  138.  
  139. 'ALLOT : W* .D W@ + .D W! ; % advances dictionary pointer
  140.             % by the amount given by top of stack
  141. 'W, :        % PLACES TOS AT END OF DICTIONARY
  142.     .D W@ W! 1 ALLOT
  143.     ;
  144. 'VARIABLE : : 3 ;    % create definition
  145.     .D W@ ARGPATCH    % point it at end of dictionary
  146.     W,        % initialize variable
  147.     ;        % finish with allocating space
  148. 'ARRAY : : 3 ;        % create definition
  149.     .D W@ ARGPATCH    % point it at end of dictionary
  150.     ALLOT ;        % allocate requested space and ;
  151.  
  152.  
  153. % VOCABULARY RELATED DEFINITIONS:
  154. '> : .V W@ DUP VBASE GT    % "POPS" VOCABULARY STACK
  155.     IF W- .V W!
  156.     ELSE "*** VSTACK UNDERFLOW***" MERR
  157.     THEN
  158.     ;
  159.  
  160. '<V :    % TRANSFERS TOS TO TOP OF VSTACK
  161.     .V W@ DUP VMAX LT
  162.     IF W+ DUP .V W! W!
  163.     ELSE "*** VSTACK OVERFLOW***" MERR
  164.     THEN
  165.     ;
  166.  
  167. 'PISTOL< : (PISTOL<) <V ;
  168.  
  169.  
  170. (PISTOL<)    'BRANCH-LIST    VARIABLE
  171.  
  172. 'BRANCH :    % CREATES AN ARRAY OF TWO ELEMENTS
  173.         % AND A PROCEDURE THAT PUSHES A ^
  174.         % TO THE FIRST ELEMENT OF THE ARRAY
  175.         % THIS FIRST ELEMENT CONTAINS A ^
  176.         % TO THE CURRENT HEAD OF THE VOCABULARY
  177.         % BRANCH AND THE SECOND ELEMENT IS A
  178.         % BACKWARD LINK TO THE PREVIOUS HEAD.
  179.         % BRANCH-LIST CONTAINS THE ^ TO THE
  180.         % THREADED LIST OF BRANCHES THAT HAVE
  181.         % BEEN DEFINED; THE BACKWARD LINK FOR
  182.         % (PISTOL<) IS "NIL"
  183. : 3 <V ; .D W@ ARGPATCH
  184.     0 .D W@ W!
  185.     BRANCH-LIST W@ .D W@ W+
  186.     W!
  187.     .D W@ BRANCH-LIST
  188.     W!
  189.     2 ALLOT
  190.     ;
  191.  
  192. 'UNLINKED< BRANCH    % CAN BE USED FOR RARELY USED, OBSCURE,
  193.         % OR DANGEROUS WORDS
  194.  
  195. CURRENT W@ W@ W+ W@ '(UNLINKED<) CONSTANT    % PROVIDES POINTER
  196.                     % TO HEAD OF THIS VOCAB.
  197.  
  198.  
  199. '3W- : W- W- W- ;
  200.  
  201. 'BLIST :    % LISTS THE NAMES OF ALL DEFINED BRANCHES
  202.     BRANCH-LIST W@
  203.     BEGIN
  204.         DUP W+ W@ DUP    % GET LINK
  205.         IF
  206.             SWAP 3W- 3W-
  207.             W@ MSG CR
  208.     REPEAT
  209.     DROP DROP
  210.     IFCR
  211.     'PISTOL< MSG
  212.     ;
  213.  
  214. % DO LOOP INDICES:
  215. 'I : 0 L@ ;
  216. 'J : 3 L@ ;
  217. 'K : 6 L@ ;
  218.  
  219. 'I' : 2 L@ 1 L@ + 1- 0 L@ - ;
  220. 'J' : 5 L@ 4 L@ + 1- 3 L@ - ;
  221. 'K' : 8 L@ 7 L@ + 1- 6 L@ - ;
  222.  
  223. % SOME LOGICAL OPERATORS:
  224.  
  225. 'LOR : IF DROP TRUE THEN ;        % LOGICAL OR
  226.  
  227. 'LAND : IF ELSE DROP FALSE THEN ;    % LOGICAL AND
  228.  
  229. 'LNOT : IF FALSE ELSE TRUE THEN ; % LOGICAL NEGATION
  230.  
  231. 'MINUS : 0 SWAP - ;
  232. 'LTZ    : MININT -1 .. ;
  233. 'GTZ    : 1 MAXINT .. ;
  234. 'EQZ    : LNOT    ;
  235. 'ABS    : DUP LTZ IF MINUS THEN ;
  236. 'EQ    : - LNOT ;
  237. 'LE : MININT SWAP .. ;
  238. 'GE : MAXINT .. ;
  239. 'MIN : DDUP GE IF SWAP THEN DROP ;
  240.  
  241. 'MAX : DDUP GE IF THEN SWAP DROP ;
  242.  
  243.  
  244. % NUMBER OUTPUT ROUTINE:
  245.  
  246. % ASCII <-- DIGIT
  247. 'ASCII : DUP 9 GT IF 55
  248.         ELSE 48
  249.     THEN + ;
  250.  
  251. '<U#> : -1 SWAP
  252.     BEGIN RADIX W@ /MOD ABS SWAP DUP LNOT END
  253.     DROP ;
  254.  
  255. '#TYPE : BEGIN DUP -1 GT IF ASCII TYO REPEAT DROP ;
  256.  
  257. '= : DUP 0 LT IF  45 TYO MINUS THEN
  258.     <U#> #TYPE ;
  259. '? : W@ = ;
  260.  
  261. % BELOW ARE WORDS THAT CONTROL DISPLAY OF CODE PRODUCED
  262. % BY THE COMPILER; CAN BE USEFUL FOR DEBUGGING AND EDUCATION
  263.  
  264. 'CODESHOW : IFCR "COMPILE BUFFER CONTAINS:" MSG CR
  265.     COMPBUF    BEGIN DUP ? TAB W+
  266.             .C W@ OVER GT LNOT
  267.         END
  268.     DROP IFCR
  269.     ;
  270. 'SHOWCODE : 0 COMPILE-END-PATCH W! ; 'CODESHOW FIND ARGPATCH
  271.  
  272. 'NOSHOWCODE : COMPILE-END-PATCH OFF ;
  273.  
  274. 'PROMPT :        % DUPLICATES PRIMITIVE PROMPT
  275.     IFCR        % FUNCTION
  276.     SP IF SP = THEN    % EXCEPT STACK SIZE SHOWN
  277.     RADIX-INDICATOR C@ TYO
  278.     SYNTAXBASE MSG
  279.     "> " MSG
  280.     ;
  281. 'PROMPT FIND PROMPT-PATCH W!    % PATCHING IT
  282.  
  283. 'ADDRESS :    DUP FIND DUP
  284.         IF
  285.             UNDER
  286.         ELSE
  287.             IFCR 39 TYO DROP MSG
  288.             " NOT FOUND" MERR
  289.         THEN
  290.     ;
  291.  
  292. '/ : /MOD DROP ;
  293. 'MOD : /MOD UNDER ;
  294.  
  295.  
  296. % CHANGING NUMBER BASES:
  297. 'HEX : 72 RADIX-INDICATOR C! 16 RADIX W! ;
  298. 'DECIMAL : 88 RADIX-INDICATOR C! 10 RADIX W! ;
  299. 'OCTAL : 81 RADIX-INDICATOR C! 8 RADIX W! ;
  300. 'BINARY : 66 RADIX-INDICATOR C! 2 RADIX W! ;
  301.  
  302.  
  303. %
  304. 'STACK : IFCR 40 TYO SP = 41 TYO % (STACKSIZE)
  305.     SP SP 12 MIN 1- 0 DO 2 SPACES DUP S@ = 1- LOOP
  306.     DROP ;
  307. %
  308. 'RSTACK : IFCR 'R( MSG RP 1- = 41 TYO % RSTACK SIZE
  309.     RP 1- DUP 12 MIN 0 DO 2 SPACES DUP R@ = 1-
  310.     LOOP DROP ;
  311.  
  312. % RECURSE ALOWS ROUTINE OR COMPBUF TO CALL ITSELF
  313. 'RECURSE :    1 R@ W-    % FIND IN WHICH WORD
  314.         0 R@ W- % FIND WHERE IS RECURSE USED
  315.         W!    % PATCH
  316.     R> W- <R        % BACKUP TO EXEC PATCH
  317.     ;
  318. %
  319. 'TELL : W- W- W@  MSG ;
  320.  
  321. 'NEXT-LINK : 3W- W@ ;
  322. %
  323. % THIS BOMBS WHEN > NUMINSTRUCTIONS
  324. 'PNAME : DUP IF
  325.         LAST-PRIMITIVE
  326.         BEGIN    DUP
  327.             IF    DDUP W@ EQ
  328.                 IF    TELL    TRUE
  329.                 ELSE    NEXT-LINK FALSE
  330.                 THEN
  331.             ELSE    '(NO_NAME) MSG    LNOT
  332.             THEN
  333.         END
  334.         DROP
  335.         ELSE '; MSG DROP
  336.         THEN
  337.     ;
  338. %
  339. 'NAME : DUP PRIMITIVE? IF
  340.     PNAME
  341.     ELSE TELL
  342.     THEN ;
  343.  
  344.  
  345. % VOCABULARY MAINTENANCE PACKAGE:
  346.  
  347. % LLIST ADDRESS AND NAME:
  348. 'LNAME : DUP = 3 SPACES NAME CR ;
  349.  
  350. % LIST LAST TEN WORDS:
  351. 'NEXT10 : IFCR 10 0 DO DUP LNOT IF ERR THEN
  352.         DUP LNAME